SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00011 EXECUTION ROUTINES 1 05-28-9313:45ALL SWAG SUPPORT TEAM EXECHILD.PAS IMPORT 35 U^á (* This unit lets you execute any child program and redirect theπ child program output to NUL / PRN / CON or file.π It's very simple to use (look at the EXAMPLE.PAS).π This source is completlly freeware but make sure to removeπ this remark if any changes are made I don't want anyone toπ spread his bugs with my source.π Of course any suggestions are welcome as well as questionsπ about the source.ππ Written by Schwartz Gabriel. 20/03/1993.π Anyone who has any question can leave me a message at π CompuServe to EliaShim address 100320,36π*)ππ{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}ππUnit Redir;ππInterfaceππVarπ IOStatus : Integer;π RedirError : Integer;π ExecuteResult : Word;ππ{------------------------------------------------------------------------------}πprocedure Execute (ProgName, ComLine, Redir: String);π{------------------------------------------------------------------------------}ππImplementationππUses DOS;ππTypeπ PMCB = ^TMCB;π TMCB = recordπ Typ : Char;π Owner : Word;π Size : Word;π end;ππ PtrRec = recordπ Ofs, Seg : Word;π end;ππ THeader = recordπ Signature : Word;π PartPag : Word;π PageCnt : Word;π ReloCnt : Word;π HdrSize : Word;π MinMem : Word;π MaxMem : Word;π ReloSS : Word;π ExeSP : Word;π ChkSum : Word;π ExeIP : Word;π ReloCS : Word;π TablOff : Word;π OverNo : Word;π end;ππVarπ PrefSeg : Word;π MinBlockSize : Word;π MCB : PMCB;π FName : PathStr;π F : File;π MyBlockSize : Word;π Header : THeader;ππ{------------------------------------------------------------------------------}ππprocedure Execute (ProgName, ComLine, Redir: String);ππtypeπ PHandles = ^THandles;π THandles = Array [Byte] of Byte;ππ PWord = ^Word;ππvarπ RedirChanged : Boolean;π Handles : PHandles;π OldHandle : Byte;ππ {............................................................................}ππ function ChangeRedir : Boolean;ππ beginπ ChangeRedir:=False;π If Redir = '' then Exit;π Assign (F, Redir);π Rewrite (F);π RedirError:=IOResult;π If IOStatus <> 0 then Exit;π Handles:=Ptr (PrefixSeg, PWord (Ptr (PrefixSeg, $34))^);π OldHandle:=Handles^[1];π Handles^[1]:=Handles^[FileRec (F).Handle];π ChangeRedir:=True;π end;ππ {............................................................................}ππ procedure CompactHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MinBlockSize + (PtrRec (HeapPtr).Seg - PtrRec (HeapOrg).Seg);π MsDos (Regs);π end;ππ {............................................................................}ππ procedure DosExecute;ππ Beginπ SwapVectors;π Exec (ProgName, ComLine);π IOStatus:=DosError;π ExecuteResult:=DosExitCode;π SwapVectors;π End;ππ {............................................................................}ππ procedure ExpandHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MyBlockSize;π MsDos (Regs);π end;ππ {............................................................................}ππ procedure RestoreRedir;ππ beginπ If not RedirChanged then Exit;π Handles^[1]:=OldHandle;π Close (F);π end;ππ {............................................................................}ππBeginπ RedirError:=0;π RedirChanged:=ChangeRedir;π CompactHeap;π DosExecute;π Expandheap;π RestoreRedir;πEnd;ππ{------------------------------------------------------------------------------}ππBeginπ SetCBreak (False);π FName:=ParamStr (0);π Assign (F, FName);π Reset (F, 1);π IOStatus:=IOResult;π If IOStatus = 0 thenπ beginπ BlockRead (F, Header, SizeOf (Header));π IOStatus:=IOResult;π If IOStatus = 0 then MinBlockSize:=Header.PageCnt * 32 + Header.MinMem + 1π Else MinBlockSize:=$8000;π Close (F);π endπ Else MinBlockSize:=$8000;π PtrRec (MCB).Seg:=PrefixSeg - 1;π PtrRec (MCB).Ofs:=$0000;π MyBlockSize:=MCB^.Size;π PrefSeg:=PrefixSeg;πEnd.π 2 05-28-9313:45ALL SWAG SUPPORT TEAM EXECINFO.PAS IMPORT 3 U!ô {$M 4096,0,4096}ππUsesπ Dos, Prompt;ππbeginπ ChangeShellPrompt('Hi There');π SwapVectors;π Exec(GetEnv('COMSPEC'),'');π SwapVectors;πend. 3 05-28-9313:45ALL SWAG SUPPORT TEAM PROMPT.PAS IMPORT 23 Uö' {$A+,B-,F-,L-,N-,O-,R-,S-,V-}ππUnit prompt;ππ{ππAuthor: Trevor J Carlsenπ PO Box 568π Port Hedlandπ Western Australia 6721π 61-[0]-91-73-2026 (voice)π 61-[0]-91-73-2930 (data )π πReleased into the public domain.ππThis Unit will automatically create a predefined prompt when shelling to Dos.πif you wish to create your own custom prompt, all that is required is to giveπthe Variable NewPrompt another value and call the Procedure ChangeShellPrompt.ππ}ππInterfaceππUses Dos;ππVarπ NewPrompt : String;ππProcedure ChangeShellPrompt(Nprompt: String);ππImplementationππ Typeπ EnvArray = Array[0..32767] of Byte;π EnvPtr = ^EnvArray;π Varπ EnvSize, EnvLen, EnvPos: Word;π NewEnv, OldEnv : EnvPtr;π TempStr : String;π x : Word;ππ Procedure ChangeShellPrompt(Nprompt: String);ππ Function MainEnvSize: Word;π Varπ x : Word;π found : Boolean;π beginπ found := False; x := 0;π Repeatπ if (OldEnv^[x] = 0) and (OldEnv^[x+1] = 0) thenπ found := Trueπ elseπ inc(x);π Until found;π MainEnvSize := x - 1;π end; { MainEnvSize}ππ Procedure AddEnvStr(Var s; Var offset: Word; len: Word);π Var st : EnvArray Absolute s;π beginπ move(st[1],NewEnv^[offset],len);π inc(offset,len+1);π end;ππ beginπ OldEnv := ptr(MemW[PrefixSeg:$2C],0);π { this gets the actual starting segment of the current Program's env }ππ EnvSize := MemW[seg(OldEnv^)-1:3] shl 4;π { Find the size of the current environment }ππ if MaxAvail < (EnvSize+256) then beginπ Writeln('Insufficient memory');π halt;π end;ππ GetMem(NewEnv, EnvSize + $100);π if ofs(NewEnv^) <> 0 then beginπ inc(LongInt(NewEnv),$10000 + ($10000 * (LongInt(NewEnv) div 16)));π LongInt(NewEnv) := LongInt(NewEnv) and $ffff0000;π end;π FillChar(NewEnv^,EnvSize + $100,0);π { Allocate heap memory For the new environment adding enough to allow }π { alignment to a paraGraph boundary or a longer prompt than the default }π { and initialise to nuls }π EnvPos := 0;ππ AddEnvStr(Nprompt,EnvPos,length(Nprompt));π For x := 1 to EnvCount do beginπ TempStr := EnvStr(x);π if TempStr <> GetEnv('PROMPT') thenπ AddEnvStr(TempStr,EnvPos,length(TempStr));π end; { For }π inc(EnvPos);π { Transfer old env Strings except the prompt to new environment }ππ if lo(DosVersion) > 2 thenπ AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-(MainEnvSize + 2));π { Add the rest of the environment }ππ MemW[PrefixSeg:$2C] := seg(NewEnv^);π { let the Program know where the new environment is }π end; { ChangeShellPrompt }ππend. { prompt }π π 4 08-17-9308:51ALL SWAG SUPPORT TEAM Demonstrates DOS Exec IMPORT 18 U {$M 8192,0,0}π{* This memory directive is used to makeπ certain there is enough memory leftπ to execute the DOS shell and anyπ other programs needed. *}ππProgram EXEC_Demo;ππ{*ππ EXEC.PASππ This program demonstrates the use ofπ Pascal's EXEC function to executeπ either an individual DOS command orπ to move into a DOS Shell.ππ You may enter any command you couldπ normally enter at a DOS prompt andπ it will execute. You may also hitπ RETURN without entering anything andπ you will enter into a DOS Shell, fromπ which you can exit by typing EXIT.ππ The program stops when you hit aπ 'Q', upper or lower case.π*}πππUses Crt, Dos;ππVarπ Command : String;ππ{**************************************}πProcedure Do_Exec; {*******************}ππ Varπ Ch : Char;ππ Beginπ If Command <> '' Thenπ Command := '/C' + Commandπ Elseπ Writeln('Type EXIT to return from the DOS Shell.');π {* The /C prefix is needed toπ execute any command other thanπ the complete DOS Shell. *}ππ SwapVectors;π Exec(GetEnv('COMSPEC'), Command);π {* GetEnv is used to read COMSPECπ from the DOS environment so theπ program knows the correct pathπ to COMMAND.COM. *}ππ SwapVectors;π Writeln;π Writeln('DOS Error = ',DosError);π If DosError <> 0 Thenπ Writeln('Could not execute COMMAND.COM');π {* We're assuming that the onlyπ reason DosError would be somethingπ other than 0 is if it couldn'tπ find the COMMAND.COM, but thereπ are other errors that can occur,π we just haven't provided for themπ here. *}ππ Writeln;π Writeln;π Writeln('Hit any key to continue...');π Ch := ReadKey;π End;πππFunction Get_Command : String;ππ Varπ Count : Integer;π Cmnd : String;ππ Beginπ Clrscr;π Write('Enter DOS Command (or Q to Quit): ');π Readln(Cmnd);π Get_Command := Cmndπ End;ππBeginπ Command := Get_Command;π While NOT ((Command = 'Q') OR (Command = 'q')) Doπ Beginπ Do_Exec;π Command := Get_Commandπ End;πEnd. 5 08-27-9321:37ALL KELD R. HANSEN Exec with Memory Shrink IMPORT 12 U (*πKELD R. HANSENππ> I need to *simulate* something like:π> {$M 16384,0,0} {reduce heap}π> Exec('c:\myprgm.exe',''); {run myprgm.exe}π> {$M 16384,110000,110000} {restore heap}ππEXECUTE shrinks your programs memory allocation to the smallest possible value,πthen runs the program and then expands it back up again. Works in TP 6.0 andπ7.0!π*)ππUSESπ DOS;ππTYPEπ STR127 = STRING[127];ππPROCEDURE ReallocateMemory(P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P+2π CMP WORD PTR P,0π JE @OKπ INC BXππ @OK:π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd,DIπ MOV WORD PTR HeapEnd+2,ESππ @X:πEND;ππFUNCTION EXECUTE(Name : PathStr ; Tail : STR127) : WORD; ASSEMBLER;πASMπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd+2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name+2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail+2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr+2π PUSH WORD PTR HeapPtrπ {$ENDIF}π CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hππ @OUT:πEND;π 6 10-28-9311:31ALL GAYLE DAVIS FIND AND EXECUTE SWAG9311 24 U {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT FINDEXEC;ππINTERFACEππUSES CRT,DOS;ππPROCEDURE FLUSHALLDOS;πPROCEDURE REBOOT;πFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD;πPROCEDURE RunInWindow (FN, Cmd : STRING; PAUSE : BOOLEAN);ππIMPLEMENTATIONπVARπ cname : STRING;π Old_29H : POINTER;ππPROCEDURE FLUSHALLDOS; ASSEMBLER;πASMπ mov ah, 0Dhπ INT 21hπ XOR cx, cxπ@1 :π push cxπ INT 28hπ pop cxπ loop @1πEND;ππPROCEDURE Reboot; assembler;πasmπ CALL FLUSHALLDOSπ MOV ds, cxπ MOV WORD PTR [472h], 1234hπ DEC cxπ PUSH cxπ PUSH dsπEND;ππ{F+}πProcedure Int29Handler(AX, BX, CX, DX, SI, DI, DS, ES, BP : Word); Interrupt;πVarπ Dummy : Byte;πbeginπ Asmπ Stiπ end;π Write(Char(Lo(Ax)));π Asmπ Cliπ end;πend;π{$F-}ππ{ EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }ππPROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P + 2π CMP WORD PTR P, 0π JE @OKπ INC BXππ @OK :π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd, DIπ MOV WORD PTR HeapEnd + 2, ESπ @X :πEND;ππ{ ZAP this DEFINE if NOT 386,486}π{..$DEFINE CPU386}ππFUNCTION EXEC (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;πASMπ CALL FLUSHALLDOSπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd + 2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name + 2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail + 2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr + 2π PUSH WORD PTR HeapPtrππ {$ENDIF}ππ CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hππ @OUT :ππEND;ππFUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD;πVAR W : PathStr;πBEGINπ DosError := 2;π W := FSEARCH (Name, GetEnv ('PATH') );π IF W = '' THEN EXIT;π EXECUTE := EXEC(W,Tail);πEND;ππPROCEDURE RunInWindow (FN, Cmd : STRING; PAUSE : BOOLEAN);ππVAR sa : BYTE;π w : pathstr;ππBEGINππ DosError := 2;π W := FSEARCH (fn, GetEnv ('PATH') );π IF W = '' THEN EXIT;π sa := Textattr;ππ GETINTVEC ($29, OLD_29H);π SETINTVEC ($29, @Int29Handler); { Install interrupt handler }π WINDOW (LO (WindMin) + 1, HI (WindMin) + 1, LO (WindMax) + 1, HI (WindMax) + 1);π EXEC (W, Cmd );π SETINTVEC ($29, OLD_29h);ππ IF PAUSE THENπ BEGINπ WRITELN;π WRITELN (' .. Any Key Continues .. ');π asmπ Mov AX, $0C00; { flush keyboard }π Int 21h;π end;π WHILE NOT KEYPRESSED DO;π asmπ Mov AX, $0C00;π Int 21h;π end;π END;π Textattr := sa;πEND;ππEND. 7 11-02-9310:33ALL KELLY SMALL Change the MASTER Env SWAG9311 14 U {πKELLY SMALLππ>Does anyone know how to change the "master" environment? I want to have myπ>program change the dos prompt and have it be there after my program ends.π>DOS's stupid little batch language can do it, so there must be a way.ππHere's a procedure that should do it from TeeCee:π}ππprocedure InitNewPrompt;π{-set up a new prompt for shelling to dos}πtypeπ _2karray = array[1..2048] of byte;π SegPtr = ^_2karray;πconstπ NewPrompt : string = ('PROMPT=Type EXIT to return to program$_$p$g'+#0);πvarπ EnvSegment,π NewEnvSeg : word;π PtrSeg,π NewEnv : SegPtr;πbeginπ EnvSegment := memw[prefixseg:$2C];π {-this gets the actual starting segment of the current program's env}ππ PtrSeg := ptr(pred(EnvSegment), 0);π {-The segment of the program's MCB - (Memory control block) }ππ getmem(NewEnv, 1072 + length(NewPrompt));π {-Allocate heap memory and allow enough room for a dummy mcb }ππ if ofs(NewEnv^) <> 0 thenπ NewEnvSeg := seg(NewEnv^) + 2π elseπ NewEnvSeg := succ(seg(NewEnv^));π {-Force the new environment to start at paragraph boundary}ππ move(PtrSeg^, mem[pred(NewEnvSeg) : 0], 16);π {-copy the old mcb and force to paragraph boundary}ππ memw[pred(NewEnvSeg) : 3] := (1072 + length(NewPrompt)) shr 4;π {-Alter the environment length by changing the dummy mcb}ππ move(NewPrompt[1], memw[NewEnvSeg : 0], length(NewPrompt));π {-install new prompt}ππ memw[prefixseg:$2C] := NewEnvSeg;π {-let the program know where the new env is}ππ move(mem[EnvSegment : 0], mem[NewEnvSeg : length(NewPrompt)], 1024);π {-shift the old env to the new area}πend;π 8 11-02-9305:32ALL MARTIN AUSTERMEIER Redirection in DOS SWAG9311 12 U {πMARTIN AUSTERMEIERππ> PKZIP Filename -Z < zipcommentπ> Is there any way to do this WithOUT calling COMSPEC For anothershell?ππyes, but much more complicated than leaving the job to %comspec..ππBefore executing PKZIP, you have toππ * open a Text Fileπ * get its handle (see TextRec); save it in - say - "newStdIn"π * then perform something likeπ if (newSTDIN <> 0) then beginπ saveHandle[STDIN]:=DosExt.DuplicateHandle (STDIN);π DosExt.ForceDuplicateHandle (newSTDIN, STDIN);π created[STDIN]:=True;π end;π (DosExt.xx Routines and STDIN Const explained below)ππ * Exec()π * Cancel redirections:π}ππProcedure CancelRedirections; { of ExecuteProgram }πVarπ redirCnt : Word;πbeginπ For redirCnt := STDIN to STDOUT doπ beginπ if created[redirCnt] thenπ beginπ DosExt.ForceDuplicateHandle(saveHandle[redirCnt], redirCnt);π DosExt.CloseHandle(saveHandle[redirCnt]);π end;π end;πend;ππConstπ STDIN = 0;π STDOUT = 1;π STDERR = 2;ππProcedure CallDos; Assembler;πAsmπ mov Dos.DosError, 0π Int 21hπ jnc @@Okπ mov Dos.DosError, axπ @@Ok:πend;ππFunction DuplicateHandle(handle : Word) : Word; Assembler;πAsmπ mov ah, 45hπ mov bx, handleπ call CallDosπ { DuplicateHandle := AX; }πend;ππProcedure ForceDuplicateHandle(h1, h2 : Word); Assembler;πAsmπ mov ah, 46hπ mov bx, h1π mov cx, h2π call CallDosπend;ππ 9 10-28-9311:30ALL MAYNARD PHILBROOK EXEC DOS in a Window SWAG9311 10 U {===================================================================πDate: 10-19-93 (19:37)πFrom: MAYNARD PHILBROOKπSubj: Re: Execwindow graphicsπ----------------------------------------------------------------------}π{$F+,I-,S-,D-}π{$m 1024, 0, 3000}ππUses Crt, Dos;πVarπOLD_29H :Pointer;πC :Char; { Holds Charactor to Write }π{$F+}ππProcedure Patch1;πInterrupt;πBeginπ Write(C);πEnd;ππProcedure Patch; Assembler;π Asmπ Push DSπ Push Axπ Mov AX, Seg C;π Mov DS, AX;π Pop AX;π Mov C, Al;π Pop DSπ Jmp Patch1;π End;πBeginπ Clrscr;π GetINtVec($29, OLD_29H);π SetIntVec($29, @Patch);π Window(14, 10, 40, 22);π ClrScr;π Exec('C:\Command.com',' /c dir');π Readkey;π SetIntVec($29, OLD_29h);πEnd.ππThe Command.com is just an example..πNote:πIf your using ANSI.SYS in Dos, this will not use Anis..πTP uses its own screen writes, but this code directs all Dos Char Outputπto the TP window.πTo Stop echo of Dos functions or what ever, use theπ> NULL at the end of the parms when executing..ππ--- MsgToss 2.0bπ * Origin: Sherwood Forest RBBS 203-455-0646 (1:327/453)π 10 10-28-9311:38ALL MIKE DICKSON Search Execute SWAG9311 14 U {===========================================================================πDate: 09-18-93 (23:25)πFrom: MIKE DICKSONπSubj: EXEC ()π---------------------------------------------------------------------------π[MM] ▒ I've written my own EXEC function that performs an FSearch() on theπ[MM] Well, that's great. (Why don't you post it!).ππOkay...here's an illustrative little program... }ππ{$M $4000,0,0 }πProgram JohnMajorHadBetterResignPrettyDamnedShortly;ππUses DOS;ππFUNCTION FileExists (FileName: String):Boolean;{ Checks if fileπexists } varπ Attr : Word;π f : file;πbeginπ Assign (f, Filename);π GetFAttr(f, attr);π FileExists := (DOSError = 0);πend;ππFUNCTION SearchExec (ProgramName, Parameters : String) : Integer;πvarπ Result : Integer;πbeginπ{ If the program doesn't exist then search on the %PATH for it }π If Not FileExists(ProgramName) thenπ ProgramName := FSearch(ProgramName, GetEnv('PATH'));ππ{ If it's a batch file then call it through the command processor }π If Pos('.BAT', ProgramName) <> 0 then beginπ Parameters := '/C '+ProgramName+' '+Parameters;π ProgramName := GetEnv('COMSPEC');π end;ππ{ Now call the program...if it didn't exist the set DOSError to 2 }π If ProgramName <> '' then beginπ SwapVectors;π Exec (ProgramName, Parameters);π Result := DOSError;π SwapVectors;π SearchExec := Result;π end else SearchExec := 2;ππend;ππbeginπ If SearchExec ('AUTOEXEC.BAT', '/?') <> 0π then writeln ('Execution was okay!')π else writeln ('Execution was NOT okay!');πend.π 11 11-02-9306:30ALL TRISDARESA SUMARJOSO Trapping INT29 Output SWAG9311 61 U {πTRISDARESA SUMARJOSOππ> I was wondering if anyone knew how to make a split screen Whileπ> making EXEC calls and not losing your Windows?ππ> Anyone got any ideas or routines that do this? I can do it easilyπ> using TTT when I just stay Within the Program, but the problems ariseπ> when I do the SwapVectors and do my Exec call, all hell breaks loose.π> Lynn.ππ Here is a Unit that I've created to trap Int 29h. the Function of thisπUnit is to trap the output that Dos spits through the Int 29h (such as XCopy,πPkZip, etc) and redirect it into a predefined Window.π Here is the stuff:π}ππUnit I29UnitA;ππ{ This Unit will trap Dos output which use Int 29h. Any otherπ method of writing the scren, such as Direct Write which bypassesπ Int 29h call, will not be trapped. }ππInterfaceππ{ Initialize the view that will be use to output the Dos output.π Will also draw basic Window frame. }πProcedure InitView(XX1, XY1, XX2, XY2 : Byte);π{ Clear the pre-defined view. }πProcedure ClearView;π{ Procedure to redirect the Turbo Pascal Write and WriteLn Procedure.π (standard OutPut only).π Do not call this Procedure twice in the row.π More than once call to this Procedure will result Pascal's standardπ output Procedure will not be restored properly. }πProcedure TrapWrite;π{ Restore Pascal's Write and WriteLn Procedure into its originalπ condition that was altered With TRAPWrite. (standard OutPut only). }πProcedure UnTrapWrite;ππImplementationππUsesπ Dos;ππTypeπ VioCharType = Recordπ Case Boolean Ofπ True : (Ch, Attr : Byte);π False : (Content : Word);π end;ππ DrvFunc = Function(Var F : TextRec) : Integer;π VioBufType = Array [0..24, 0..79] Of VioCharType;ππVarπ OldInt29 : Pointer;π OldExit : Pointer;π OldIOFunc : DrvFunc;π OldFlushFunc : DrvFunc;π TrapWriteVar : Boolean;π X1, Y1, X2,π Y2 : Byte;π XVio : Byte;π YVio : Byte;π VioBuffer : ^VioBufType;π VioCurLoc : Word Absolute $0040:$0050;ππ{$F+}πProcedure NewInt29(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);πInterrupt;πbeginπ VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr And Not 112;π if (Lo(AX) = 13) Thenπ beginπ XVio := X1;π AX := 0;π endπ elseπ if (Lo(AX) = 10) Thenπ beginπ Inc(YVio);π AX := 0;π end;π beginπ if (XVio > X2) Thenπ beginπ XVio := X1;π Inc(YVio);π end;π if (YVio > Y2) Thenπ beginπ Asmπ Mov AH, 06π Mov AL, YVioπ Sub AL, Y2π Mov CH, Y1π Mov CL, X1π Mov DH, Y2π Mov DL, X2π Mov BH, 07π Int 10hπ end;ππ YVio := Y2;π end;ππ if (Lo(AX) = 32) Thenπ beginπ if (Lo(VioCurLoc) < XVio) Thenπ beginπ XVio := Lo(VioCurLoc);π VioBuffer^[YVio, XVio].Ch := Lo(AX);π endπ elseπ beginπ VioBuffer^[YVio, XVio].Ch := Lo(AX);π Inc(XVio);π end;π endπ elseπ beginπ VioBuffer^[YVio, XVio].Ch := Lo(AX);π Inc(XVio);π end;π VioCurLoc := YVio Shl 8 + XVio;π end;π VioBuffer^[YVio, XVio].Attr := VioBuffer^[YVio, XVio].Attr Or 112;πend;π{$F-}ππ{$F+}πProcedure RestoreInt29;πbeginπ ExitProc := OldExit;π SetIntVec($29, OldInt29);π if TrapWriteVar Thenπ beginπ TextRec(OutPut).InOutFunc := @OldIOFunc;π TextRec(OutPut).FlushFunc := @OldFlushFunc;π end;πend;π{$F-}ππProcedure HookInt29;πbeginπ GetIntVec($29, OldInt29);π SetIntVec($29, @NewInt29);π OldExit := ExitProc;π ExitProc := @RestoreInt29;πend;ππProcedure InitView(XX1, XY1, XX2, XY2: Byte);πVarπ I : Byte;πbeginπ X1 := XX1+1;π Y1 := XY1+1;π X2 := XX2-1;π Y2 := XY2-1;π XVio := X1;π YVio := Y1;π For I := XX1 To XX2 Doπ beginπ VioBuffer^[XY1, I].Ch := 205;π VioBuffer^[XY2, I].Ch := 205;π end;π For I := XY1+1 To XY2-1 Doπ beginπ VioBuffer^[I, XX1].Ch := 179;π VioBuffer^[I, XX2].Ch := 179;π end;π VioBuffer^[XY1, XX1].Ch := 213;π VioBuffer^[XY2, XX1].Ch := 212;π VioBuffer^[XY1, XX2].Ch := 184;π VioBuffer^[XY2, XX2].Ch := 190;π VioCurLoc := YVio Shl 8 + XVio;πend;ππProcedure DoWriteStuff(F : TextRec);πVarπ I : Integer;π Regs : Registers;πbeginπ For I := 0 To F.BufPos-1 Doπ beginπ Regs.AL := Byte(F.BufPtr^[I]);π Intr($29, Regs);π end;πend;ππ{$F+}πFunction NewOutputFunc(Var F : TextRec) : Integer;πbeginπ DoWriteStuff(F);π F.BufPos := 0;π NewOutPutFunc := 0;πend;π{$F-}ππ{$F+}πFunction NewFlushFunc(Var F : TextRec) : Integer;πbeginπ DoWriteStuff(F);π F.BufPos := 0;π NewFlushFunc := 0;πend;π{$F-}ππProcedure TrapWrite;πbeginπ if Not TrapWriteVar Thenπ beginπ With TextRec(OutPut) Doπ beginπ OldIOFunc := DrvFunc(InOutFunc);π InOutFunc := @NewOutPutFunc;π OldFlushFunc := DrvFUnc(FlushFunc);π FlushFunc := @NewFlushFunc;π end;π TrapWriteVar := True;π end;πend;ππProcedure UnTrapWrite;πbeginπ if TrapWriteVar Thenπ beginπ TextRec(OutPut).InOutFunc := @OldIOFunc;π TextRec(OutPut).FlushFunc := @OldFlushFunc;π TrapWriteVar := False;π end;πend;ππProcedure ClearView;πbeginπ Asmπ Mov AH, 06π Mov AL, 0π Mov CH, Y1π Mov CL, X1π Mov DH, Y2π Mov DL, X2π Mov BH, 07π Int 10hπ end;π XVio := X1;π YVio := Y1;π VioCurLoc := YVio Shl 8 + XVio;πend;ππProcedure CheckMode;πVarπ MyRegs : Registers;πbeginπ MyRegs.AH := $F;π Intr($10, MyRegs);π Case MyRegs.AL Ofπ 0, 1, 2, 3 : VioBuffer := Ptr($B800, $0000);π 7 : VioBuffer := Ptr($B000, $0000);π end;πend;ππbeginπ X1 := 0;π Y1 := 0;π X2 := 79;π Y2 := 24;π XVio := 0;π YVio := 0;π VioCurLoc := YVio Shl 8 + XVio;π HookInt29;π TrapWriteVar := False;π CheckMode;πend.πππProgram Int29Testing;ππ{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}π{$M $800,0,0}ππUsesπ Dos, Crt,π I29UnitA;ππVarπ CmdLine : String;π I : Byte;ππ{ Function to convert a String to upper case.π Return the upper-case String. }ππFunction Str2Upr(Str : String) : String; Assembler;πAsmπ Push DSπ CLDπ LDS SI, Strπ LES DI, @Resultπ LodSBπ Or AL, ALπ Jz @Doneπ StoSBπ Xor CH, CHπ Mov CL, ALπ @@1:π LodSBπ Cmp AL, 'a'π JB @@2π Cmp AL, 'z'π JA @@2π Sub AL, 20hπ @@2:π StoSBπ Loop @@1π @Done:π Pop DSπend;ππbeginπ ClrScr;π GotoXY(1,1);π WriteLn('Output interceptor.');π { Initialize redirector's area. }π InitView(0,2,79,24);π Repeatπ { Redirect Turbo's output into the predefined Window. }π TrapWrite;π Write(#0,' Please enter Dos command (Done to Exit): ');π ReadLn(CmdLine);π WriteLn;π { Restore Turbo's original Output routine. }π UnTrapWrite;π GotoXY(1,2);π WriteLn('Command executed : ', CmdLine);π CmdLine := Str2Upr(CmdLine);π if (CmdLine <> 'DONE') And (CmdLine <> '') Thenπ beginπ SwapVectors;π Exec('C:\Command.Com', '/C'+CmdLine);π SwapVectors;π end;π GotoXY(1,2);π WriteLn('Command execution done. Press anykey to continue...');π Repeat Until ReadKey <> #0;π ClearView;π GotoXY(1,2);π WriteLn(' ');π Until (CmdLine = 'DONE');π ClrScr;πend.ππ{πBoth the testing Program and the Unit itself (expecially the Unit), is by noπmean perfect. Use With caution. It might not wise to use such redirectorπ(my int 29 Unit) in a Program that swaps itself out of memory. The aboveπPrograms were not optimized in anyway (so it might slow your Program aπlittle). And I don't guarantee that this Program will work on your computerπ(it work Without a problem on mine). if you like this Unit, you can use itπanyway you desire. Just remember I can guarantee nothing For this method.π}π
